perm filename TEST[E,ALS]17 blob
sn#265094 filedate 1977-02-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 LABEL1: page 2
C00003 00003 LABEL2: PAGE 3
C00004 00004 LABEL3: PAGE 4
C00006 00005 Page 5
C00008 00006 NEWDLI
C00013 00007 HELP GET STRIP ASK FIND
C00018 00008 MKROOM INSERT FULL DELETE ADD CORRECT NICK REPORT UPDATE GAME
C00035 00009 $CLASS FATAL NONFATAL CATCRLF OPENFILE USETOUT USETIN BK!PRV
C00053 00010 HAND,NOHAND FUTURE,PAST UPTO,#,CRLF,LF,TAB SUPERCOMMENT
C00055 00011 P,SP,ATJRST,ARERR,FIX JRSTF,!JBDDT,!JBOPC,!JBSYM,!JBHRL,HALT
C00057 ENDMK
C⊗;
LABEL1: page 2
page 2 line 2
LABEL2: PAGE 3
zzzz
page 3 line 3
LABEL3: PAGE 4
yyyy
xxxx
page 4 line 4
Page 5
This is some text to test with and it has no meaning of itself.
This is some text to test with and it has no meaning of itself.
This is some text to test with and it has no meaning of itself.
This is some text to test with and it has no meaning of itself.
This is some text to test with and it has no meaning of itself.
This is some text to test with and it has no meaning of itself.
This is some text to test with and it has no meaning of itself.
This is some text to test with and it has no meaning of itself.
yyyy
This is some text to test with and it has no meaning of itself.
This is some text to test with and it has no meaning of itself.
xxxx
Page 5 line 5
;NEWDLI
;NEWDLI NEWD1
;NEWDLI NEWD1 NEWD2 NEWD3 NEWD4 NEWD5
;NEWDLI NEWD1 NEWD2 NEWD3 NEWD4 NEWD5
COMMENT;
;NEWDLI NEWD1 NEWD2 NEWD3 NEWD4 NEWD5
;NEWDLI
;NEWDLI NEWD1
;NEWDLI NEWD1 NEWD2 NEWD3 NEWD4 NEWD5
;NEWDLI NEWD1 NEWD2 NEWD3 NEWD4 NEWD5
;This code generates a new first line, listing all labels (in SAIL format)
↑↑NEWDLI: PUSHJ P,ENDSET ;To guarentee that new line will be at the end of FS
TLO F,NOCHK ;Don't CORE DOWN untill through
MOVEI A,1
PUSHJ P,SETARR
TRO F,UPDTXT ;This is the first line on the page
MOVEI B,PAGE ;Start at top of page
HRRZ H,FSEND
ADDI H,1
HRRZ T,(B)
HLLZ Q,TXTFLG(T) ;Save flags
LEG HLLM Q,TXTFLG(H)
HRRZS TXTFLG(T) ;No longer the first line
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H) ;Assign H new serial number
MOVEM TT,SRCNUM
HRRZ T,(B) ;Link up new area as first line on page
HRRM T,(H)
HRLM B,(H)
HRLM H,(T)
HRRM H,PAGE
HRRZM H,ARRLIN
HRRZM H,WINLIN
MOVE I,H
ADD H,[440700,,LLDESC] ;Pointer for depositing text
MOVEI C,73 ;Start with a ;
LEG IDPB C,H
MOVEI E,40
SETZB Q,G ;Q counts labels, G counts characters
HRRZ B,(I) ;Start on old first line
↑NEWD1: MOVSI T,-10
MOVE D,B
ADD D,[440700,,LLDESC]
NEWD2: MOVEM D,DSAVE#
ILDB C,D
CAIE C,40
CAIN C,11
JRST NEWD2 ;Ignore initial spaces and TABS
SKIPA
NEWD3: ILDB C,D ;Check line for a label
CAIN C,72 ;Is it a colon?
AOJA Q,NEWD5 ;Go copy this label
CAIE C,15 ;Are we at the end of the line?
CAIN C,73 ;Is it a semicolon?
SKIPA
AOBJN T,NEWD3
NEWD4: HRRZ B,(B) ;Go to the next line
CAIE B,BOTSTR
JRST NEWD1 ;and try again
LDB C,H
CAIE C,40
AOJA G,.+2 ;Initial semicolon was not counted
ADD H,[70000,,0] ;Overwrite last space which was counted
MOVEI C,15
LEG IDPB C,H
MOVEI C,12
LEG IDPB C,H
TDZA C,C
LEG IDPB C,H ;And a null
TLNE H,760000
JRST .-2
MOVSI TT,2(G) ;2 for CRLF + char. count
ADDI TT,(G) ;but only char. count into right half
MOVEM TT,TXTCNT(I) ;Record char counts
AOS LINES ;Add to line count
HLRZ T,TXTCNT(I)
ADDM T,CHARS ;Add to char count
MOVE T,I ;Display text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert to ASCID
CAIGE T,(H)
AOJA T,.-2
MOVEI TT,2(H)
MOVSI T,TXTCOD
FSFIX TT,T
PUSHJ P,ENDFIX
TLZ F,NOCHK
PUSHJ P,LINSET
PUSHJ P,SETWRT
HRRZ T,TXTCNT(I)
SETZM TYOPNT
OUTSTR [ASCIZ/
The new line lists /]
TYPDEC Q
OUTSTR [ASCIZ/ labels, in /]
TYPDEC T
OUTSTR [ASCIZ/ characters. /]
JRST POPJ1
NEWD5: MOVE D,DSAVE ;Go back and copy this label
HRRZS T
ILDB C,D
LEG IDPB C,H
AOS G
SOJG T,.-3
LEG IDPB E,H
AOJA G,NEWD4
COMMENT HELP GET STRIP ASK FIND;
COMMENT HELP GET STRIP ASK FIND;
BEGIN "BOWLS"
DEFINE ⊂="BEGIN",⊃="END",$="COMMENT";
DEFINE SIZE="24",BSIZE="1024";
DEFINE \=" "; $ DEFINE \="SAFE"; $ Simple way to change to SAFE;
INTEGER ARRAY BUF,BUF2[0:1023],NDATA,RDATA[0:32],DATA[0:32];
INTEGER H,I,J,K,L,M,MM,N,P,Q,QQ,LENX,LENB,SIDEOF,BRCHR,CHAN1,CHAN2,EOF,SIDE,TSIZE,DELTA2;
SHORT REAL SCORE,RATING,DELTA;
STRING READ1,READ2,READ3,READ4,READ5,READX,READA,READW,READB,READN,READP,READC,READD,READY;
BOOLEAN ER;
LABEL MAIN1,MAIN2;
PROCEDURE HELP;
⊂ OUTSTR('11&"The Bowling on the Green Report"&'15&'12);
OUTSTR ("
Services are: 0. Exit. 1. Add game. 2. Add name.
3. Corection. 4. Ratings. 5. List names. 6. List games.
7. Suggestions. 8. Help me. 9. Delete name from list.
After you have typed a number to designate the type of service
required, you will be asked a series of questions. A carriage return
should terminate your answer. A carriage return only will terminate
most queries and go on to the next item, the exception being when you
are asked to verify a proposed entry. In thes case your answer should
be a Y or a N followed by a carriage return.
");
⊃ ;
PROCEDURE GET; $ Get nickname and convert to caps.;
⊂ LABEL GET1;
GET1: OUTSTR ('11&"Nickname = "); READX←INCHWL;
LENX←LENGTH(READX); IF LENX>6 THEN LENX←6;
J←CVSIX(READX); READX←CVXSTR(J)[1 FOR LENX];
⊃ ;
PROCEDURE STRIP; $ Strip trailing spaces;
⊂ FOR Q←6 STEP -1 UNTIL 1 DO IF READB[Q FOR 1]≠" " THEN DONE;
READB←READB[1 FOR Q]; QQ←QQ+Q;
⊃ ;
PROCEDURE ASK; $ Ask for confirmation showing full name;
⊂ LABEL ASK1;
ASK1: OUTSTR ('11&"Do you mean "&CVXSTR(BUF[I]));
OUTSTR(" i.e. ");
FOR K←2 STEP 1 UNTIL 5 DO OUTSTR(CVSTR(BUF[I+K])); OUTSTR("?"&'11);
READY←(INCHWL)[1 for 1];
IF EQU(READY,"Y")∨EQU(READY,"y") THEN J←I ELSE
⊂ J←I+SIZE; OUTSTR ("Ambiguous! "); ⊃ ;
⊃ ;
PROCEDURE FIND; $ Find nickname in list;
$ J<I not found, J=I found, J>I ambiguous.;
⊂
LABEL FIND1,FIND2,FIND3,FIND4;
FOR I←0 STEP SIZE UNTIL 1008 DO
⊂ "ILOOP"
FIND1: IF BUF[I]=0 THEN ⊂ J←I-SIZE; DONE; ⊃ ELSE
READB←CVXSTR(BUF[I]); READ1←READX;
STRIP;
FOR K←1 STEP 1 UNTIL 6 DO
⊂ L←LOP(READ1); M←LOP(READB); IF (L≠M)∨(L=0)∨(M=0) THEN DONE; ⊃ ;
FIND2: IF L=M THEN ⊂ J←I; DONE; ⊃ ;
FIND3: IF M=0 THEN ⊂ ASK; DONE; ⊃ ;
IF L=0 THEN
⊂ READ1←READX; READB←CVXSTR(BUF[I+SIZE]);
STRIP;
FOR N←1 STEP 1 UNTIL K DO
⊂ L←LOP(READ1); M←LOP(READB); IF (L≠M)∨(L=0)∨(M=0) THEN DONE; ⊃ ;
IF (L≠M)∧(L≠0) THEN ⊂ J←I; DONE "ILOOP"; ⊃
ELSE ⊂ J←I+SIZE; DONE "ILOOP"; ⊃ ;
⊃ ;
FIND4: IF L<M THEN ⊂ J←I-SIZE; DONE; ⊃ ;
⊃ ;
⊃ ;
COMMENT MKROOM INSERT FULL DELETE ADD CORRECT NICK REPORT UPDATE GAME
TEAMS NLIST GLIST LIKELY;
PROCEDURE MKROOM;
⊂
LABEL MKRO1;
MKRO1: IF BUF[I]≠0 THEN
⊂ FOR K←I STEP SIZE UNTIL 1008 DO IF BUF[K]=0 THEN DONE;
IF K≥1008 THEN OUTSTR("Too many players! ") ELSE
⊂ FOR K←K-1 STEP -1 UNTIL I DO BUF[K+SIZE]←BUF[K];
FOR K←I+SIZE-1 STEP -1 UNTIL I DO BUF[K]←0;
⊃ ;
⊃ ;
⊃ ;
PROCEDURE INSERT; $ To add new name to list;
⊂
LABEL INSER1;
INSER1: BUF[I]←CVSIX(READX);
⊃ ;
PROCEDURE FULL;
⊂ OUTSTR('11&"Type full name for record "); READ3←INCHWL; J←1;
READ3←READ3&" "; $ Pad it out by 12 blanks;
FOR K←2 STEP 1 UNTIL 5 DO ⊂ BUF[I+K]←CVASC(READ3[J FOR 5]); J←J+5; ⊃ ;
BUF[I+6]←0; BUF[I+7]←10000;
⊃ ;
PROCEDURE DELETE; $ Delete name from list;
⊂ GET;
FIND;
IF I≠J THEN OUTSTR("Not found"&'15&'12) ELSE
⊂ OUTSTR("Do you really want to delete "&CVXSTR(BUF[I]));
OUTSTR('11);
FOR J←4 STEP 1 UNTIL 7 DO OUTSTR(CVSTR(BUF[I+J]));
OUTSTR("? ");
READY←(INCHWL)[1 for 1];
IF EQU(READY,"Y")∨EQU(READY,"y") THEN
FOR J←I STEP 1 UNTIL 999 DO
BUF[J]←BUF[J+SIZE];
⊃ ;
⊃ ;
PROCEDURE ADD;
⊂ "ADD" $ Returns index in I for location of nickname;
WHILE TRUE DO
⊂ "TLOOP"
GET;
IF LENX=0 THEN DONE "TLOOP";
FIND;
IF I>J THEN ⊂ MKROOM; INSERT; FULL; ⊃ ;
IF I=J THEN OUTSTR ("This nickname has already been used"&'15&'12);
⊃ "TLOOP";
⊃ "ADD";
PROCEDURE CORRECT;
⊂ "CORRECT"
WHILE TRUE DO
⊂ "TLOOP"
OUTSTR("Type old ");
GET;
IF LENX=0 THEN DONE "TLOOP";
FIND;
IF J≠I THEN ⊂ OUTSTR("Ambiguous, try again."&'15&'12); CONTINUE; ⊃ ELSE
⊂ OUTSTR (" for ");
FOR K←2 STEP 1 UNTIL 5 DO OUTSTR(CVSTR(BUF[I+K]));
OUTSTR ('15&'12&"CR or corrected nickname ");
GET;
IF LENX≠0 THEN INSERT;
OUTSTR("CR or correct full name ");
READ3←INCHWL;
IF ¬EQU(READ3,"") THEN
⊂ READ3←READ3&" "; $ Pad it out by 12 blanks;
FOR K←2 STEP 1 UNTIL 5 DO ⊂ BUF[I+K]←CVASC(READ3[J FOR 5]); J←J+5; ⊃ ;
⊃ ;
OUTSTR("Has played "&CVS(BUF[I+6])); OUTSTR(" games. CR or correct ");
READ2←INCHWL; IF LENGTH(READ2)≠0 THEN BUF[I+6]←CVD(READ2);
RATING←BUF[I+7]; RATING←RATING/100-100;
OUTSTR("With a rating of "&CVF(RATING)&" CR or correct ");
READ4←INCHWL; IF (LENGTH(READ4))>0 THEN
⊂ READX←""; READP←"."; READC←",";
FOR K←1 STEP 1 UNTIL 3 DO
⊂ READ5←LOP(READ4); IF EQU(READ5,READP)∨EQU(READ5,READC) THEN DONE;
READX←READX&READ5;
⊃ ;
IF EQU(READ5,READC) THEN READX←READX&"00" ELSE
⊂ READX←READX&READ5;
READ4←LOP(READ3);
IF EQU(READ4,READC) THEN READ4←"0";
READX←READX&READ4;
⊃ ;
BUF[I+7]←CVD(READX);
⊃ ;
⊃ ;
⊃ "TLOOP";
⊃ "CORRECT";
PROCEDURE NICK;
⊂ READ1←READ2←READ3←"";
IF I≥SIZE THEN FOR J←2 STEP 1 UNTIL 5 DO READ1←READ1&CVSTR(BUF[I-SIZE+J]);
FOR J←2 STEP 1 UNTIL 5 DO READ2←READ2&CVSTR(BUF[I+J]);
IF ¬ EQU(BUF[I+SIZE+2],"") THEN
FOR J←2 STEP 1 UNTIL 5 DO READ3←READ3&CVSTR(BUF[I+SIZE+J]);
FOR K←1 STEP 1 UNTIL 20 DO
⊂ L←LOP(READ1); M←LOP(READ2); N←LOP(READ3);
⊃ ;
⊃ ;
PROCEDURE REPORT;
⊂ "REPORT"
LABEL REP1,REP2,REP3,REP4;
I←J←0; NDATA[J]←I; RDATA[J]←BUF[I+7];
OUTSTR('15&'12&
"Rating Nickn. Played on With Against With earlier"&'15&'12);
REP1: FOR I←SIZE STEP SIZE UNTIL 1008 DO
⊂ IF BUF[I]=0 THEN DONE; L←I%SIZE;
NDATA[L]←I; RDATA[L]←BUF[I+7];
REP2: FOR J←L STEP -1 UNTIL 1 DO
⊂ IF RDATA[J]≤RDATA[J-1] THEN DONE;
REP3: K←NDATA[J]; NDATA[J]←NDATA[J-1]; NDATA[J-1]←K;
K←RDATA[J]; RDATA[J]←RDATA[J-1]; RDATA[J-1]←K;
⊃ ;
⊃ ;
REP4: FOR K←0 STEP 1 UNTIL L DO
⊂ I←NDATA[K]; IF BUF[I]=0 THEN DONE;
RATING←BUF[I+7]; RATING←(RATING/100)-100;
OUTSTR('15&'12&CVF(RATING));
OUTSTR('11&CVXSTR(BUF[I]));
OUTSTR('11);
OUTSTR(CVXSTR(BUF[I+18]));
OUTSTR('11); QQ←0;
FOR J←8 STEP 1 UNTIL 11 DO
⊂ READB←CVXSTR(BUF[I+J]);
STRIP;
OUTSTR(READB[1 FOR Q]);
IF BUF[I+J+1]=0 THEN DONE; OUTSTR(","); QQ←QQ+1;
⊃ ;
FOR Q←QQ STEP 1 UNTIL 11 DO OUTSTR(" "); OUTSTR(" "); QQ←0;
FOR J←12 STEP 1 UNTIL 17 DO
⊂ READB←CVXSTR(BUF[I+J]);
STRIP;
OUTSTR(READB[1 FOR Q]);
IF BUF[I+J+1]=0 THEN DONE; OUTSTR(","); QQ←QQ+1;
⊃ ;
FOR Q←QQ STEP 1 UNTIL 17 DO OUTSTR(" "); OUTSTR(" ");
FOR J←20 STEP 1 UNTIL 23 DO
⊂ READB←CVXSTR(BUF[I+J]);
STRIP;
OUTSTR(READB[1 FOR Q]);
IF BUF[I+J+1]=0 THEN DONE; OUTSTR(",");
⊃ ;
⊃ ;
OUTSTR('15&'12&'12&'12);
⊃ "REPORT";
PROCEDURE UPDATE;
⊂
WHILE TRUE DO
⊂ GET;
FIND;
IF I>J THEN
⊂ OUTSTR('11&"Is this a new name to add? ");
READY←(INCHWL)[1 for 1];
IF EQU(READY,"Y")∨EQU(READY,"y") THEN
⊂ MKROOM; INSERT; FULL; J←I; ⊃ ;
⊃ ;
IF I=J THEN
⊂ K←BUF[I+6]; L←BUF[I+7]; RATING←L; RATING←RATING/100-100;
OUTSTR (CVSTR(BUF[I+2])&CVSTR(BUF[I+3])&CVSTR(BUF[I+4])&CVSTR(BUF[I+5]));
SETFORMAT(1,0);
OUTSTR (" Game "&CVS(K+1));
SETFORMAT(3,2);
OUTSTR(" Rating was "&CVF(RATING));
RATING←((RATING*3)+DELTA)/4;
OUTSTR (" changed to "&CVF(RATING)&'15&'12);
RATING←(RATING+100)*100; L←RATING;
OUTSTR("Is this OK?"&'11);
READY←(INCHWL)[1 FOR 1];
IF EQU(READY,"Y")∨EQU(READY,"y") THEN
⊂ BUF[I+6]←BUF[I+6]+1; BUF[I+7]←L;
DATA[P]←BUF[I]; P←P+1;
DONE;
⊃ ELSE OUTSTR ("Sorry, try again ");
⊃ ;
⊃ ;
⊃ ;
PROCEDURE GAME;
⊂ "GAME"
INTEGER HH,JJ,JJJ;
LABEL GA0,GA1,GA2,GA3,GA4,GA5,GA6;
SETFORMAT(5,3);
OUTSTR('15&'12&'11&"Type date of game = ");
READD←INCHWL;
WHILE TRUE DO
⊂ OUTSTR('11&"Type score difference = ");
IF LENGTH((READ1←INCHWL))=0 THEN DONE;
DELTA2←DELTA←CVD(READ1);
OUTSTR('11&"Type number on each side = ");
SIDE←CVD(INCHWL);
DELTA←DELTA/SIDE;
OUTSTR('11&'11&"List winners by nickname"&'15&'12);
P←0;
GA0: FOR JJJ←1 STEP 1 UNTIL SIDE DO UPDATE;
DELTA←0-DELTA;
OUTSTR('15&'12&'11&'11&"Now list losers by nickname"&'15&'12);
FOR JJJ←1 STEP 1 UNTIL SIDE DO UPDATE;
$ Add to list of teams, testing cell containing SIDE for empty slot;
FOR J←2 STEP 12 UNTIL 1010 DO IF BUF2[J]=0 THEN DONE;
IF J>1010 THEN
⊂ FOR J←0 STEP 1 UNTIL 1007 DO BUF2[J]←BUF2[J+12];
FOR J←1008 STEP 1 UNTIL 1023 DO BUF2[J]←0;
J←1008;
⊃ ELSE J←J-2;
BUF2[J]←CVSIX(READD); BUF2[J+2]←SIDE; BUF2[J+3]←DELTA2;
FOR K←0 STEP 1 UNTIL 7 DO BUF2[J+K+4]←DATA[K];
$ Now make lists of team-mates and opponents;
HH←(SIDE*2)-1; JJ←SIDE-1;
GA1: FOR H←0 STEP 1 UNTIL HH DO
⊂ READB←CVXSTR(DATA[H]);
STRIP;
READX←READB;
FIND;
GA2: FOR L←8 STEP 1 UNTIL 11 DO BUF[I+L+12]←BUF[I+L];
FOR L←8 STEP 1 UNTIL 17 DO BUF[I+L]←0;
L←8; M←12;
GA3: FOR J←0 STEP 1 UNTIL HH DO
⊂ IF ((H≤JJ)∧(J≤JJ))∨((H>JJ)∧(J>JJ)) THEN
⊂ IF J≠H THEN ⊂ BUF[I+L]←DATA[J]; L←L+1; ⊃ ;
⊃ ELSE
⊂ BUF[I+M]←DATA[J]; M←M+1;
⊃ ;
⊃ ;
GA4: WHILE L≤11 DO ⊂ BUF[I+L]←0; L←L+1; ⊃ ;
WHILE M≤17 DO ⊂ BUF[I+M]←0; M←M+1; ⊃ ;
BUF[I+18]←CVSIX(READD);
⊃ ;
OUTSTR('11&"Game has been recorded. Next game please."&'15&'12&'12);
⊃ ;
⊃ "GAME";
PROCEDURE TEAMS;
⊂ INTEGER JJ;
OUTSTR('15&'12&"Date Delta Winning team Losing team"&'15&'12);
FOR J←2 STEP 12 UNTIL 1008 DO IF BUF2[J]=0 THEN DONE;
IF J<14 THEN J←14;
FOR J←J-14 STEP -12 UNTIL 0 DO
⊂ OUTSTR('15&'12);
OUTSTR(CVXSTR(BUF2[J]));
SIDE←BUF2[J+2]; JJ←SIDE-1;
OUTSTR('11&CVS(BUF2[J+3]));
OUTSTR('11);
QQ←0;
FOR K←0 STEP 1 UNTIL JJ DO
⊂ READB←CVXSTR(BUF2[J+4+K]);
STRIP; OUTSTR(READB);
IF BUF2[J+5+K]=0 THEN DONE; OUTSTR(","); QQ←QQ+1;
⊃ ;
FOR Q←QQ STEP 1 UNTIL 20 DO OUTSTR(" "); OUTSTR(" ");
FOR K←SIDE STEP 1 UNTIL 7 DO
⊂ READB←CVXSTR(BUF2[J+4+K]);
STRIP; OUTSTR(READB);
IF BUF2[J+5+K]=0 THEN DONE; OUTSTR(","); QQ←QQ+1;
⊃ ;
⊃ ;
OUTSTR('15&'12&'12);
⊃ ;
PROCEDURE NLIST;
⊂ "NLIST"
OUTSTR("Nickn. Games Rating Name"&'15&'12);
FOR I←0 STEP SIZE UNTIL 1000 DO
⊂ IF BUF[I]=0 THEN DONE;
OUTSTR('15&'12);
RATING←BUF[I+7]; RATING←RATING/100-100;
OUTSTR(CVXSTR(BUF[I]));
SETFORMAT(3,0);
OUTSTR('11&CVS(BUF[I+6]));
SETFORMAT(5,2);
OUTSTR('11&CVF(RATING)); OUTSTR('11);
FOR K←2 STEP 1 UNTIL 5 DO OUTSTR(CVSTR(BUF[I+K]));
⊃ ;
OUTSTR('15&'12&'12&'12);
⊃ "NLIST";
PROCEDURE GLIST;
⊂ "GLIST"
⊃ "GLIST";
PROCEDURE LIKELY;
⊂ INTEGER II,JJ,KK,LL;
INTEGER ARRAY DATA2[0:64];
LABEL LI1,LI2,LI3;
OUTSTR('12&'12&'11&'11&"Bowling on the Green"&'15&'12&'12);
OUTSTR("Name Likely suggestions for people to play");
FOR I←0 STEP SIZE UNTIL BSIZE DO
⊂ "ILOOP" $ Consider each person on the list;
IF BUF[I]=0 THEN DONE;
FOR II←0 STEP SIZE UNTIL BSIZE DO
⊂ "IILOOP" $ Make up 2 lists of the other players;
IF BUF[II]=0 THEN DONE;
J←II%SIZE; IF I≠II THEN DATA[J]←DATA2[J]←BUF[II] ELSE DATA[J]←DATA2[J]←0;
⊃ "IILOOP";
LI1: JJ←J; $ JJ contains the total number of players;
FOR J←2 STEP 12 UNTIL BSIZE DO IF BUF2[J]=0 THEN DONE;
$ Now start with the most recent game;
OUTSTR('15&'12);
FOR J←J-12 STEP -12 UNTIL 2 DO
⊂ "JLOOP" $ Consider the games one at a time, backwards;
SIDE←BUF2[J];
IF SIDE=0 THEN CONTINUE; $ There is an error somewhere;
$ Check winning sides;
FOR K←1 STEP 1 UNTIL SIDE DO
⊂ "KWLOOP"
LI2: IF BUF2[J+K+1]≠BUF[I] THEN CONTINUE ELSE
$ for team-mates;
⊂ FOR LL←1 STEP 1 UNTIL SIDE DO
⊂ IF BUF2[J+LL+1]=0 THEN DONE;
FOR L←0 STEP 1 UNTIL JJ DO IF DATA[L]=BUF2[J+LL+1] THEN
⊂ DATA[L]←0; DONE; ⊃ ;
⊃ ;
$ and for opponents;
FOR LL←SIDE+1 STEP 1 UNTIL SIDE*2 DO
⊂ IF BUF2[J+LL+1]=0 THEN DONE;
FOR L←0 STEP 1 UNTIL JJ DO IF DATA2[L]=BUF2[J+LL+1] THEN
⊂ DATA2[L]←0; DONE; ⊃ ;
⊃ ;
⊃ ;
⊃ "KWLOOP";
$ Check losing sides;
FOR K←SIDE+1 STEP 1 UNTIL SIDE*2 DO
⊂ "KLLOOP"
LI3: IF BUF2[J+K+1]≠BUF[I] THEN CONTINUE ELSE
$ for team-mates;
⊂ FOR LL←SIDE+1 STEP 1 UNTIL SIDE*2 DO
⊂ IF BUF2[J+LL+1]=0 THEN DONE;
FOR L←0 STEP 1 UNTIL JJ DO IF DATA[L]=BUF2[J+LL+1] THEN
⊂ DATA[L]←0; DONE; ⊃
⊃ ;
$ and for opponents;
FOR LL←1 STEP 1 UNTIL SIDE DO
⊂ IF BUF2[J+LL+1]=0 THEN DONE;
FOR L←0 STEP 1 UNTIL JJ DO IF DATA2[L]=BUF2[J+LL+1] THEN
⊂ DATA2[L]←0; DONE; ⊃
⊃ ;
⊃ ;
⊃ "KLLOOP";
⊃ "JLOOP";
OUTSTR('15&'12&CVXSTR(BUF[I]));
OUTSTR('15&'12&"With ");
KK←0;
FOR L←0 STEP 1 UNTIL JJ DO
⊂ IF KK≥9 THEN ⊂ OUTSTR('15&'12&'11); KK←0; ⊃;
IF DATA[L]≠0 THEN
⊂ OUTSTR(CVXSTR(DATA[L])); OUTSTR(" "); KK←KK+1; ⊃ ;
⊃ ;
OUTSTR('15&'12&"Against ");
KK←0;
FOR L←0 STEP 1 UNTIL JJ DO
⊂ IF KK≥9 THEN ⊂ OUTSTR('15&'12&'11); KK←0; ⊃;
IF DATA2[L]≠0 THEN
⊂ OUTSTR(CVXSTR(DATA2[L])); OUTSTR(" "); KK←KK+1; ⊃ ;
⊃ ;
⊃ "ILOOP";
OUTSTR('15&'12&'12);
⊃ ;
COMMENT $CLASS FATAL NONFATAL CATCRLF OPENFILE USETOUT USETIN BK!PRV;
ENTRY BAIL,B!;
BEGIN "BILGE"
REQUIRE "[][]" DELIMITERS;
REQUIRE 64 STRING!PDL; COMMENT STANDARD IS 40;
LET DEFINE=REDEFINE;
COMMENT INSTALLATION DEPENDENT MACROS AND SETTINGS.
STANFORD sets STANFO on, DEC off
DEC sets STANFO off, DEC on
TENEX taken care of automatically by testing for GTJFN;
IFCR DECLARATION(GTJFN)
THENC DEFINE TENX(A)=[A], NOTENX(A)=[], STANFO(A)=[], DEC(A)=[];
ELSEC DEFINE TENX(A)=[], NOTENX(A)=[A]; ENDC;
IFCR EQU(COMPILER!BANNER[LENGTH(SCANC(COMPILER!BANNER,"-",NULL,"IA"))+1 FOR 8]
,"TYMSHARE") THENC
DEFINE TYMSW(A)=[A],NOTYMSW(A)=[]; ELSEC
DEFINE TYMSW(A)=[],NOTYMSW(A)=[A]; ENDC
NOTENX([ DEFINE DEC(A)=[], STANFO(A)=[A]; ])
STANFO([DEFINE CH!SETC=['176],CH!ALT=['175]; COMMENT RIGHT BRACE, ALTMODE;
DEFINE CORE!IMAGE!EXTENSION=["DMP"];
DEFINE MAX#TXTFIL=[31];
REQUIRE "
STANFORD VERSION" MESSAGE;
])
DEC([ DEFINE CH!SETC=['175],CH!ALT=['33];
DEFINE CORE!IMAGE!EXTENSION=["SAV"];
DEFINE MAX#TXTFIL=[31];
NOTYMSW([REQUIRE "
DEC TOPS-10 VERSION" MESSAGE;])
TYMSW([ REQUIRE "
TYMSHARE VERSION" MESSAGE;])
])
TENX([ DEFINE CH!SETC=['175],CH!ALT=['33];
DEFINE CORE!IMAGE!EXTENSION=["SAV"];
DEFINE MAX#TXTFIL=[99];
REQUIRE "
TENX VERSION" MESSAGE;
])
DEFINE HAND(A)=[A], NOHAND(A)=[];
DEFINE FUTURE(A)=[],PAST(A)=[];
DEFINE UPTO=[STEP 1 UNTIL], #=[COMMENT], CRLF=[('15 & '12)], LF=['12],TAB=['11];
DEFINE SUPERCOMMENT(A)=[];
DEFINE CHECK(A)=[NOW!UNSAFE A],NOCHECK(A)=[NOW!SAFE A];
DEFINE MEMLOC(A,B)=[MEMORY[LOCATION(A),B]];
DEFINE LEFT(A)=[((A) LSH -18)], RIGHT(A)=[((A) LAND '777777)];
DEFINE P=['17], SP=['16],
ATJRST=['254020000000],ARERR=['007000000000],FIX=['003000000000];
DEFINE JRSTF=['254100000000],!JBDDT=['74],!JBOPC=['130],!JBSYM=['116],
!JBHRL=['115],HALT=[JRST 4,];
DEFINE PD!NPW=[4],PD!DSP=[5],PD!DLW=[7],PD!PPD=['11],PD!PCW=['12];
EXTERNAL INTEGER !SKIP!,!ERRP!,!ERRJ!,BALNK;
INTEGER !RECOVERY!,#ERRP#,#SKIP#;
EXTERNAL INTEGER PDLNK;
EXTERNAL SAFE INTEGER ARRAY GOGTAB[0:'300];
REQUIRE NOTENX(["SYS:GOGTAB.DEF"]) TENX(["<SAIL>GOGTAB.DEF"]) SOURCE!FILE;
SUPERCOMMENT([
# ABOVE REQUIRE IS MOSTLY A TEST OF THE NEW WAY TO DO AWAY WITH USERCON.
GOGTAB.DEF IS PRODUCED BY SCISS WHEN A NEW LIBRARY IS MADE, AND CONTAINS
DEFINITIONS OF THE USER TABLE ENTRY NAMES AND THEIR VALUES. IF THE FILE
IS NOT AROUND, TRY THESE:
DEFINE REMCHR=['12],TOPBYT=['11],UUO1=['0],BKTPRV=['34];
STANFO([DEFINE RACS=['135],BAILOC=['243];])
DEC([DEFINE RACS=['133],BAILOC=['241];])
TENX([DEFINE RACS=['133],BAILOC=['246];])
]) # END SUPERCOMMENT;
EXTERNAL RECORD!CLASS $CLASS(INTEGER RECRNG,HNDLER,RECSIZ;
INTEGER ARRAY TYPARR; STRING ARRAY TXTARR);
SIMPLE PROCEDURE FATAL(STRING A); USERERR(0,0,A);
SIMPLE PROCEDURE NONFATAL(STRING A); USERERR(0,1,A);
NOTENX([
DEFINE CFILE(A)="RELEASE(A)";
FORWARD SIMPLE STRING PROCEDURE CATCRLF(STRING A);
EXTERNAL INTEGER INIACS;
STRING RUNDEV,RUNPPN; # set from INIACS if RUN or GET;
SIMPLE INTEGER PROCEDURE OPENFILE(REFERENCE STRING FILNAM; STRING MODES);
BEGIN "OPENFILE"
# like TENEX-SAIL, extended if errors;
EXTERNAL INTEGER !SKIP!;
INTEGER CHN,FLAG,R,W,E,TRIAL; LABEL BAD,TRY,TRY2; STRING DEV,FIL;
PRESET!WITH
"no such file ", "illegal PPN ", "protection ", "busy ", "???";
OWN SAFE STRING ARRAY REASON[0:4];
IF (CHN←GETCHAN)<0 THEN GOTO BAD;
QUICK!CODE SETZM TRIAL; END;
TRY: DEV←"DSK";
TRY2:
START!CODE LABEL LOOP1,LOOP2,TEST1,TEST2,USEDFLT;
SETZB 1,2; # R,W;
SETZM E;
HRRZ 3,-1(SP); # LENGTH(MODES);
MOVE 5,(SP); # BP;
JRST TEST1;
LOOP1:ILDB 4,5;
CAIN 4,"R";
MOVEI 1,2(1);
CAIN 4,"W";
MOVEI 2,2(2);
CAIN 4,"E";
SETOM E;
TEST1:SOJGE 3,LOOP1;
MOVEM 1,R;
MOVEM 2,W;
MOVEI 4,FIL; # FIL←FILNAM;
MOVE 5,-1(P); # ADDR(FILNAM);
HRRZ 1,-1(5); # LENGTH(FILNAM);
MOVEM 1,-1(4);
MOVE 2,(5); # BP;
MOVEM 2,(4);
JRST TEST2;
LOOP2:ILDB 3,2;
CAIE 3,":";
TEST2:SOJGE 1,LOOP2;
JUMPL 1,USEDFLT; # NO COLON, USE DEFAULT;
EXCH 1,-1(4); # 1←ORIG LEN, -1(4)←LEN OF NAME;
EXCH 2,(4); # 2←DEV BP, (4)←NAME BP;
MOVEI 3,DEV;
MOVEM 2,(3); # DEVICE BP TO CORE;
SUB 1,-1(4); # LEN+1 OF DEV=ORIG LEN - LEN OF NAME;
SUBI 1,1; # CORRECT FOR COLON;
MOVEM 1,-1(3); # LENGTH TO CORE;
USEDFLT:SETZM FLAG;
END;
RELEASE(CHN); OPEN(CHN,DEV,'10,R,W,FLAG,FLAG,FLAG); IF FLAG THEN GOTO BAD;
IF W THEN ENTER(CHN,FIL,!SKIP!) ELSE
IF R THEN LOOKUP(CHN,FIL,!SKIP!);
IF !SKIP! AND TRIAL=0 THEN BEGIN
# try harder; IF LENGTH(RUNDEV) THEN DEV←RUNDEV; CVFIL(FIL,TRIAL,FLAG);
IF NOT(FLAG) THEN
# originally, no PPN; FILNAM←FILNAM&RUNPPN; QUICK!CODE SETOM TRIAL; END;
GOTO TRY2 END;
IF !SKIP! AND NOT(E) THEN BEGIN
OUTSTR("
File error, "&REASON[RIGHT(!SKIP!) MIN 4]& DEV&":"&FIL& "
Try again, ALT to ignore:");
CLRBUF; STANFO([PTOSTR(0,DEV&":"&FIL);])
FILNAM←INCHWL; IF !SKIP! NEQ CH!ALT THEN GOTO TRY END;
RETURN(CHN);
BAD: CFILE(CHN); RETURN(!SKIP!←TRUE);
END "OPENFILE";
]); # NOTENX;
TENX([ DEFINE USETOUT(CHAN,BLOCK)=[USETO(CHAN,BLOCK)],
USETIN(CHAN,BLOCK)=[USETI(CHAN,BLOCK)];
]) # TENX;
NOTENX([
STANFO([ DEFINE USETOUT(CHAN,BLOCK)=[USETO(CHAN,BLOCK)],
USETIN(CHAN,BLOCK)=[USETI(CHAN,BLOCK)];
]); # STANFO;
DEC([
SIMPLE PROCEDURE USETOUT(INTEGER CHAN,BLOCK); BEGIN
START!CODE
HRLZ 1,CHAN;
LSH 1,5;
TLO 1,'067000; # MAKE AN "OUTPUT" INSTRUCTION;
XCT 1; # FORCE OUT PARTIAL BUFFER;
END;
USETO(CHAN,BLOCK); END;
SIMPLE PROCEDURE USETIN(INTEGER CHAN,BLOCK); BEGIN
# THIS IS MORE COMPLICATED, SINCE WE MAY HAVE TO FLUSH SEVERAL BUFFERS;
START!CODE
DEFINE ICOWNT=['12],BUFHED=[2]; LABEL TOPP,NOBUF;
EXTERNAL INTEGER CHNCDB;
HRLZ 1,CHAN;
LSH 1,5;
IOR 1,['10+('047 LSH 27)]; # CALLI 10, WAIT;
XCT 1; # WAIT TILL DISK STOPS;
PUSH P,CHAN;
PUSHJ P,CHNCDB; # AC! GETS ADDR OF CHAN DATA BLOCK;
SETZM ICOWNT(1); # SO SAIL WILL DO AN IN NEXT TIME;
HRRZ 3,BUFHED(1); # ADDR OF INPUT BUFFER HEADER;
JUMPE 3,NOBUF;
HRRZ 2,(3); # AC2=BUFFER POINTED TO BY HEADER;
MOVEI 3,(2); # AC3=BUFFER IN WHICH TO CLEAR USE BIT;
MOVSI 4,'400000; # BIT TO CLEAR;
TOPP: ANDCAM 4,(3); # CLEAR BIT;
HRRZ 3,(3); # NEXT BUFFER;
CAIE 2,(3); # SAME AS FIRST?;
JRST TOPP; # NO;
NOBUF: END;
USETI(CHAN,BLOCK); END;
# ALL THIS IS NECESSARY BECAUSE THE DEC UUOs DO NOT FLUSH THE BUFFER,
WHILE STANFORD IS NICE AND DOES;
]) # DEC;
]) # NOTENX;
# SPECIAL BREAKTABLE STUFF;
DEFINE DELIMS=[('00 & '11 & '12 & '13 & '14 & '15 & '40)];
# NULL,TAB,LF,VT,FF,CR,SP;
# Dot (period) must be last for BK!ID2. Can save space by not mentioning
lowercase because BK!ID and BK!ID2 convert to upper first ("K" mode);
DEFINE LETTERS=["ABCDEFGHIJKLMNOPQRSTUVWXYZ!" & "αβπλ⊂⊃∀∃→_~#$\|."],
DIGITS=["0123456789"], SAILID=[(DIGITS & LETTERS)],
NUMBER=[(DIGITS & ".@")];
# THE ASCII FOR THOSE STANFORD CHARACTERS UNDER LETTERS IS:
002 (ALPHA), 003 (BETA), 007 (PI), 010 (LAMBDA),
020 (SUBSET), 021 (REVERSE SUBSET), 024 (FOR ALL), 025 (THERE EXISTS)
030 (UNDERSCORE), 031 (RIGHT ARROW), 032 (TILDE);
DEFINE QUOTE=['042];
PRESET!WITH
TAB,NULL,"INS",
DELIMS,NULL,"XNR",
QUOTE,NULL,"INA",
"01234567",NULL,"XNR",
NUMBER,NULL,"XNR",
".@",NULL,"INR",
SAILID,NULL,"XNRK";
SAFE STRING ARRAY BK!SBR[0:6,0:2]; # SETBREAK WILL BE DONE WITH THESE;
PRELOAD!WITH [8]0;
SAFE INTEGER ARRAY BK!TBL[0:7]; # TABLE NUMBERS STORED HERE;
DEFINE BK!TAB=[BK!TBL[0]],BK!DLM=[BK!TBL[1]],BK!QUO=[BK!TBL[2]],
BK!OCT=[BK!TBL[3]],BK!NUM=[BK!TBL[4]],BK!DEC=[BK!TBL[5]],BK!ID=[BK!TBL[6]],
BK!ID2=[BK!TBL[7]];
# tab,delimiters,quote,octal digits,floating decimal,
decimal digits,identifiers,ids without period;
# EXTERNAL INTEGER BKTPRV; # BREAKTABLE PRIVILEGE WORD;
SIMPLE INTEGER PROCEDURE BK!PRV(BOOLEAN MODE);
# USERCON(BKTPRV,MODE,TRUE);
BEGIN GOGTAB[BKTPRV] SWAP MODE; RETURN(MODE) END;
# SETS BREAKTABLE PRIVILEGE;
DEFINE SM1LNK(I)=[MEMORY[SM1PNT+I]], T!NAME(I)=[MEMORY[C!NAME+I]],
T!BLKADR(I)=[MEMORY[C!BLKADR+I]], T!CRDIDX(I)=[MEMORY[C!CRDIDX+I]];
DEFINE PAGEIT(A,B)=[T!NAME(B)];
DEFINE N!CACHE=[100], BOTTOM!SLOT=[95], N!BK=[16], L!BK=[(N!BK-1)];
DEFINE HRELOC(A)=[(A+HZERO)], LRELOC(A)=[(A+LZERO)];
INTEGER BAIJFN,TMPJFN; # CHANNEL NUMBERS FOR .BAI FILE AND TEXT FILES;
INTEGER C!NAME, # ADDRESS OF NAME TABLE;
C!BLKADR, # ADDRESS OF BLKADR TABLE;
C!CRDIDX, # ADDRESS OF COORDINATE INDEX TABLE;
L!NAME, # INDEX OF LAST ENTRY CURRENTLY USED IN NAME TABLE;
L!BLKADR, # BLKADR TABLE;
L!CACHE, # CACHE;
L!CRDIDX, # COORDINATE INDEX;
L!TXTFIL, # TEXTFILE TABLE;
N!NAME, # NUMBER OF ENTRIES ALLOCATED IN NAME TABLE;
N!BLKADR, # BLKADR;
N!CRDIDX # COORDINATE INDEX;
;
INTEGER BKLEV; # BREAKPOINT RECURSION LEVEL;
INTEGER PJPBAIL; # CONTAINS PUSHJ P,BAIL AT RUNTIME;
INTERNAL STRING !!QUERY; # TO BE SET BY USER ON EXPLICIT CALL TO BAIL;
INTEGER BAILOFF,NAME!POINTER; # ANOTHER SWITCH, USETI POINTER TO NAME TABLE IN .BAI FILE;
STRING ARRAY T!TXTFIL[0:MAX#TXTFIL]; # NAMES OF TEXT FILES;
PRELOAD!WITH [MAX#TXTFIL+1] 0;
INTEGER ARRAY STATUS[0:MAX#TXTFIL]; # FOR STATUS OF THESE FILES;
PRELOAD!WITH [N!CACHE] 0;
INTEGER ARRAY CACHE[0:N!CACHE-1]; # 20 MOST RECENT NAMES (5 WORDS PER);
PRELOAD!WITH [256] 0;
INTEGER ARRAY TARRAY[0:255]; # TEMPORARY ARRAY;
PRELOAD!WITH [N!BK] 0;
INTERNAL INTEGER ARRAY BK!LOC, BK!INSTR,BK!COUNT[0:L!BK];
# BREAK LOCATIONS, SAVED INSTRUCTIONS, MULTIPLE PROCEED COUNTS;
INTERNAL STRING ARRAY BK!COND,BK!ACT,BK!NAME[0:L!BK];
# TO BE EVALUATED FOR CONDITIONAL BREAK, AUTOMATIC ACTION. ID;
PRELOAD!WITH ['17+'12+1+1+1] 0;
INTEGER ARRAY TEMP!ACS[0:'17+'12+1+1]; # HOLDING TANK UNTIL RECURSIVE SAIVING;
PRELOAD!WITH [8] 0;
INTEGER ARRAY TRAP[0:8]; # PLACE TO DO INTERCEPTIONS;
STRING !STR!; # GLOBAL ACCUMULATOR FOR PIECE-WISE OUTPUT;
BOOLEAN SSF; # SPECIAL STRING FLAG, TRUE→NO QUOTE-IZE;
INTEGER MULDEF; # FALSE→TOTALLY UNKNOWN, TRUE→MULTIPLY DEFINED;
INTEGER TLDEPTH;
PRELOAD!WITH [16] 0;
INTEGER ARRAY TLSCOPE[0:15]; # KLUGE FOR TFIND;
INTEGER CRDCTR; # "GLOBAL" COUNTER OF COORDINATE NUMBERS;
PRELOAD!WITH ["G"-"A"] NULL," !!GO;",["P"-"H"] NULL," !!GO;",
["S"-"Q"] NULL," !!STEP;",["X"-"T"] NULL," !!GSTEP;",["Z"-"Y"+1] NULL;
INTERNAL SAFE STRING ARRAY MACTAB["A":"Z"]; # MACRO TABLE;
INTEGER PRGSM1; # ptr to "main program" on .SM1 BALNK chain;
COMMENT HAND,NOHAND FUTURE,PAST UPTO,#,CRLF,LF,TAB SUPERCOMMENT
CHECK,NOCHECK MEMLOC LEFT,RIGHT;
DEFINE HAND(A)=[A], NOHAND(A)=[];
DEFINE FUTURE(A)=[],PAST(A)=[];
DEFINE UPTO=[STEP 1 UNTIL], #=[COMMENT], CRLF=[('15 & '12)], LF=['12],TAB=['11];
DEFINE SUPERCOMMENT(A)=[];
DEFINE CHECK(A)=[NOW!UNSAFE A],NOCHECK(A)=[NOW!SAFE A];
DEFINE MEMLOC(A,B)=[MEMORY[LOCATION(A),B]];
DEFINE LEFT(A)=[((A) LSH -18)], RIGHT(A)=[((A) LAND '777777)];
COMMENT P,SP,ATJRST,ARERR,FIX JRSTF,!JBDDT,!JBOPC,!JBSYM,!JBHRL,HALT
PD!NPW,PD!DSP,PD!DLW,PD!PPD,PD!PCW;
COMMENT;
COMMENT P,SP,ATJRST,ARERR,FIX JRSTF,!JBDDT,!JBOPC,!JBSYM,!JBHRL,HALT
PD!NPW,PD!DSP,PD!DLW,PD!PPD,PD!PCW;
COMMENT P,SP,ATJRST,ARERR,FIX JRSTF,!JBDDT,!JBOPC,!JBSYM,!JBHRL,HALT
PD!NPW,PD!DSP,PD!DLW,PD!PPD,PD!PCW;
DEFINE P=['17], SP=['16],
ATJRST=['254020000000],ARERR=['007000000000],FIX=['003000000000];
DEFINE JRSTF=['254100000000],!JBDDT=['74],!JBOPC=['130],!JBSYM=['116],
!JBHRL=['115],HALT=[JRST 4,];
DEFINE PD!NPW=[4],PD!DSP=[5],PD!DLW=[7],PD!PPD=['11],PD!PCW=['12];
EXTERNAL INTEGER !SKIP!,!ERRP!,!ERRJ!,BALNK;
INTEGER !RECOVERY!,#ERRP#,#SKIP#;